home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™94 / Talks & Papers / Timothy Knox / yerk 3.66 / tool+ / popUpMenus < prev    next >
Text File  |  1994-06-24  |  4KB  |  139 lines
  1. \ stringvar - class of strings which are kept in memory
  2. \             as barrays and have a max length - from mh
  3. \ 5.24.89    rfl    twidth and type replaces stringwidth and drawstring
  4. \                 inset rect before print and changed 2 to 1 in justification
  5. \ 12.4.89    rfl a few modifications cosmetic
  6. \ 5.24.90    rfl    redid justinbox stuff to shorten code
  7. \ 7.12.92    rfl    deleted stringvar class
  8. \ 5.20.93    rfl    removed cursor stuff
  9. \ 8.4.93    rfl    mitem now points to text (from 1 not zero)...compatible with new pMenu fix. PROPOGATES
  10. \ 10.20.93    rfl    fixed exec: to not exec if no item was selected
  11. \  3.3.94    rfl    set: window for print: also
  12.  
  13. \ Bitmap class for drawing bitmaps to screen
  14. :CLASS bMap  <Super warray
  15.  
  16.     Var        BaseAddr
  17.     Int        RowBytes
  18.     Rect    BndsRect
  19.     rect    DestRect
  20.  
  21.     \ (  n  l t r b -- )
  22.     :M  INIT:   Put:  bndsRect  Put: RowBytes  ;M
  23.  
  24.     :M putDest: { x y \ x0 y0 -- } size: BndsRect -> y0 -> x0
  25.             x y x0 x + y0 y + put: destRect ;M
  26.  
  27.     :M draw: idxbase +base Put: BaseAddr
  28.             abs: self portBit: actw
  29.             abs: BndsRect abs: destRect
  30.             word0 0 call copyBits ;M
  31.  
  32.     :M offset: ( dx dy -- ) offset: destrect ;M
  33.  
  34.     :M moveto: ( x y -- ) putDest: self draw: self ;M
  35.  
  36. ;CLASS
  37.  
  38. 5 bmap darrow    \ instantiate a global down pointing arrow
  39. hex
  40. $ ff80 $ 7f00 $ 3e00 $ 1c00 $ 0800  put: darrow
  41. decimal
  42. 2 0 0 9 5 init: darrow
  43.  
  44. \ draw text string justified in a given rectangle
  45. : ctextbox { addr len arect just -- }
  46.         addr +base len aRect +base just makeint call textbox ;
  47.  
  48. \ definition of class that handles popup menus
  49.  
  50. \ popupRect provides a way to use pmenu
  51. \    two kinds of disp/print are supported:
  52. \        display a fixed name string or
  53. \        display the last selected item in menu
  54.  
  55. :CLASS popUpMenu <super pMenu
  56.     int            dmode        \ display mode: ITEM (0) or NAME (1)
  57.     var            myAction    \ Menu has an action independent of item handler
  58.     var            myWindow    \ owning window
  59. 33    bytes        name        \ string holds name of rect...limited to 32 characters
  60.     int         txFont      \ retains its type of font
  61.     int         txSize
  62.     int         txFace
  63.     int            txJust        \ justification left(0), center(1), right(-1)
  64.     rect        myBorder    \ rectangle framing menu
  65.  
  66.   :M placeDarrow: getBotX: myBorder
  67.         13 - size: myBorder swap drop 2/ getTopY: myBorder + 2- putDest: darrow ;M
  68.  
  69. \ *** initializing methods ***
  70.   :M font: ( font size face -- ) put: txFace put: txSize put: txFont ;M
  71.   :M justify: put: txJust ;M
  72.   :M actions: put: myAction ;M
  73.   :M putWindow: put: myWindow ;M
  74.   :M setMode: ( displayMode -- ) put: dmode ;M
  75.   :M putRect: ( l t r b -- ) put: myBorder placeDarrow: self
  76.         getTop: myBorder offset: self ;M
  77.  
  78.   :M initFont: pushPort set: [ obj: myWindow ]
  79.         get: txFont tfont get: txSize tsize get: txFace tface popPort ;M
  80.  
  81.   :M getRect: ( -- topx topy botx boty ) get: myBorder ;M
  82.  
  83.   :M name: ( addr len -- ) dup 32 > classerr" 133 addr: name >str255 drop ;M
  84.  
  85.   :M getName: ( -- addr len ) addr: name count ;M
  86.  
  87.   :M print: ( -- ) pushPort actw obj: myWindow -> actw set: actw
  88.         2 1 inset: myBorder getBotX: myBorder dup 10 - putBotX: myBorder
  89.         1 tmode initFont: self
  90.         getName: self addr: myBorder get: txJust ctextBox 
  91.         putBotX: myBorder -2 -1 inset: myBorder  placeDarrow: self draw: darrow
  92.         -> actw popPort ;M
  93.  
  94.   :M draw: ( -- ) pushPort set: [ obj: myWindow ]
  95.         1 1 offset: myBorder draw: myBorder
  96.         -1 -1 offset: myBorder clear: myBorder draw: myBorder print: self popPort ;M
  97.  
  98.   :M ptIn: ( point --) ptIn: myBorder ;M
  99.  
  100.   :M exec: ( -- ) where: theMouse pack ptin: self
  101.         IF popup: self
  102.             mitem 0>        \ don't do anything if no item selected
  103.             IF get: dmode 0=
  104.                 IF    mitem checkOne: self mitem getText: self name: self print: self THEN
  105.                 exec: myAction
  106.             THEN
  107.         THEN ;M
  108.  
  109. \   :M firstName: get: dmode 0=
  110. \         IF getItem: self  get: super
  111. \             name: self print: self
  112. \         THEN ;M
  113.  
  114.   :M classinit: ( -- )  classinit: super
  115.         12 put: txSize 1 put: type  nullcfa put: myAction ;M
  116.  
  117. ;CLASS
  118.  
  119. \ EXAMPLE - create a menu in a resource file with ID 128 and 4 items
  120. \ " .rsrc" openresfile
  121. \ 
  122. \ 4 popUpMenu SampleMen        \ instantiate
  123. \ : itemHandler home mitem . ;
  124. \ 4 'cfas itemHandler itemHandler itemHandler itemHandler 128 put: SampleMen
  125. \ fwind putWindow: SampleMen
  126. \ 
  127. \ 240 18 320 34 putRect: SampleMen
  128. \ 0 12 0 font: SampleMen
  129. \ konstant tejustleft justify: SampleMen
  130. \ 
  131. \ getnew: SampleMen        \ read menu from resource file
  132. \ insert: SampleMen        \ insert it into the menubar
  133. \ 
  134. \ : doSample exec: sampleMen ;
  135. \ : drawSample draw: sampleMen ;
  136. \ 4 'cfas null null drawSample doSample actions: fwind
  137. \ 
  138. \ draw: sampleMen
  139.